Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/mquery/mgrid.frm

Text File | 1995-05-02 | 19KB | 737 lines

VERSION 2.00
Begin Form fGridFrm
   BackColor       =   &H00C0C0C0&
   ClientHeight    =   3135
   ClientLeft      =   1455
   ClientTop       =   2640
   ClientWidth     =   6675
   ClipControls    =   0   'False
   Height          =   3540
   Icon            =   MGRID.FRX:0000
   Left            =   1395
   LinkTopic       =   "Form1"
   ScaleHeight     =   3125.913
   ScaleMode       =   0  'User
   ScaleWidth      =   6692.959
   Tag             =   "Dynaset"
   Top             =   2295
   Width           =   6795
   Begin Grid cGrid
      Height          =   2715
      Left            =   0
      TabIndex        =   9
      Top             =   420
      Width           =   6675
   End
   Begin PictureBox ViewButtons
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      Height          =   375
      Left            =   0
      ScaleHeight     =   372
      ScaleMode       =   0  'User
      ScaleWidth      =   5171.607
      TabIndex        =   0
      Top             =   24
      Width           =   5175
      Begin CommandButton SortButton
         Caption         =   "&Sort"
         Height          =   372
         Left            =   3720
         TabIndex        =   8
         Top             =   0
         Width           =   612
      End
      Begin CommandButton FilterButton
         Caption         =   "Fil&ter"
         Height          =   372
         Left            =   3120
         TabIndex        =   7
         Top             =   0
         Width           =   612
      End
      Begin CommandButton RefreshButton
         Caption         =   "&Redo"
         Height          =   372
         Left            =   2520
         TabIndex        =   6
         Top             =   0
         Width           =   612
      End
      Begin CommandButton CloseButton
         Cancel          =   -1  'True
         Caption         =   "&Close"
         Height          =   372
         Left            =   4320
         TabIndex        =   5
         Top             =   0
         Width           =   612
      End
      Begin CommandButton MoreButton
         Caption         =   "&More"
         Height          =   372
         Left            =   1320
         TabIndex        =   4
         Top             =   0
         Width           =   612
      End
      Begin CommandButton NextButton
         Caption         =   "&Next"
         Height          =   372
         Left            =   120
         TabIndex        =   3
         Top             =   0
         Width           =   612
      End
      Begin CommandButton FirstButton
         Caption         =   "&First"
         Height          =   372
         Left            =   720
         TabIndex        =   2
         Top             =   0
         Width           =   612
      End
      Begin CommandButton FindButton
         Caption         =   "F&ind"
         Height          =   372
         Left            =   1920
         TabIndex        =   1
         Top             =   0
         Width           =   612
      End
   End
End

Option Explicit

'form variables
'Dim FDS As dynaset         'current form's dynaset
Dim FDS As snapshot        'current form's snapshot
Dim FDynSt As String       'dynaset open string
Dim FTblname As String     'form dynaset table name
Dim FCurrentRow As Long    'current row in dynaset
Dim FGridRow As Integer    'current grid row
Dim FNotFound As Integer   'find not found flag
Dim FFindForm As New fFind 'find form
Dim FNumbRows As Long      'total number of rows in table
Dim FDynaString As String  'dynaset open string

Sub cGrid_DblClick ()
  Dim r As Integer       'return from execute sql
  Dim fn As String       'field name

  On Error GoTo ZoomErr
  r = cGrid.Row
  cGrid.Row = 0
  'get field name
  fn = cGrid.Text
  cGrid.Row = r

  'make sure it's a string or memo field
  'If FDS(fn).Type = FT_STRING Or FDS(fn).Type = FT_MEMO Then
    ' gstZoomData = cGrid.Text
    ' fZoom.Caption = fn
    ' fZoom.Top = Top + 1200
    ' fZoom.Left = Left + 250
    ' fZoom.CloseZoomButton.Visible = True
     'fZoom.Show MODAL
  'End If
  GoTo ZoomEnd

ZoomErr:
  ShowError
  Resume ZoomEnd

ZoomEnd:

End Sub

Sub cGrid_KeyUp (KeyCode As Integer, Shift As Integer)
  'zoom on F4 key press
  If KeyCode = &H73 Then   'F4
    cGrid_DblClick
  End If
End Sub

Sub CloseButton_Click ()
  If Not gStoredFlag Then ' this query did not come from storage
    fQuery.RunSaveQryButton.Caption = "&Store Query "
    fQuery.RunSaveQryButton.Enabled = True
    fQuery.RunQueryButton.Enabled = False
    Else
    fQuery.RunSaveQryButton.Caption = "&Load Query"
    fQuery.RunSaveQryButton.Enabled = False
    fQuery.RunQueryButton.Enabled = False
    'gStoredFlag = False
  End If

  fQuery.Show
  Unload Me
End Sub

Sub FilterButton_Click ()
  On Error GoTo FilterErr

'  Dim ds1 As dynaset, ds2 As dynaset
  Dim ds1 As snapshot, ds2 As snapshot
  'Dim gFilterStr As String
  Dim numbrows As Long    'local number of rows

  Set ds1 = FDS            'save the dynaset
   Dim i As Integer, r As Integer, c As Integer

   'On Error GoTo FindErr

   'load the column names into the filter form
   'the 1st time it is loaded
     fFilter.cExpr.Text = ""
     fFilter.cFieldList.Clear
     r = cGrid.Row
     c = cGrid.Col
     cGrid.Row = 0
     cGrid.Col = 0
     For i = 1 To cGrid.Cols - 1
       cGrid.Col = cGrid.Col + 1
       fFilter.cFieldList.AddItem cGrid.Text
     Next
     cGrid.Row = r
     cGrid.Col = c


   MsgBar "Enter Search Parameters without quotes", False

  fFilter.Show MODAL

  'gFilterStr = InputBox("Enter Filter Expression:")
  If gFilterStr = "" Then Exit Sub

  FDS.Filter = gFilterStr
'  Set ds2 = FDS.CreateDynaset()            'establish the filter
  Set ds2 = FDS.CreateSnapshot()            'establish the filter
  Set FDS = ds2            'assign back to original dynaset object

  'everything must be okay so redisplay form on 1st record
  FNumbRows = GetNumbRecsSS(FDS)          'query numb of recs
   If FNumbRows = -1 Then
     'error occurred but go on anyway
     'because row count is non-critical
     Caption = "Dynaset: " + FTblname
     numbrows = gwMaxGridRows
     FCurrentRow = numbrows
   ElseIf FNumbRows = 0 Then
     Beep
     MsgBox "No Records found!", 48
     ResetMouse Me
     Unload Me
     fQuery.Show
     Exit Sub
   ElseIf FNumbRows > gwMaxGridRows Then
     Caption = "Dynaset: " + FTblname + " [" + CStr(FNumbRows) + " total rows]"
     numbrows = gwMaxGridRows
     FCurrentRow = numbrows
   Else
     numbrows = FNumbRows
     Caption = "Dynaset: " + FTblname + " [" + CStr(FNumbRows) + " rows]"
   End If
  If LoadGrid(cGrid, FDS, FDynSt, numbrows, 0) = False Then
    Unload Me
    fQuery.Show
    Exit Sub
  End If
  GoTo FilterEnd

FilterErr:
  ShowError
  Set FDS = ds1            're-assign back to original
  Resume FilterEnd

FilterEnd:

End Sub

Sub FindButton_Click ()
   Dim i As Integer, r As Integer, c As Integer

   On Error GoTo FindErr

   'load the column names into the find form
   'the 1st time it is loaded
   If FFindForm.cFieldList.ListCount = 0 Then
     FFindForm.cFieldList.Clear
     r = cGrid.Row
     c = cGrid.Col
     cGrid.Row = 0
     cGrid.Col = 0
     For i = 1 To cGrid.Cols - 1
       cGrid.Col = cGrid.Col + 1
       FFindForm.cFieldList.AddItem cGrid.Text
     Next
     cGrid.Row = r
     cGrid.Col = c
   End If

FindStart:       'used to loop around on not found

   'reset the flags
   gfFindFailed = False
   gfFromTableView = True

   MsgBar "Enter Search Parameters", False

   FFindForm.Show MODAL

   MsgBar "Searching for record", True

   If gfFindFailed = True Then Exit Sub

   FNotFound = False

   SetHourGlass Me

   'search for the record
   cGrid.SetFocus        'start at the top
   SendKeys "^{Home}"
   cGrid.Col = 1
   cGrid.Row = 0
   'move the right column
   While cGrid.Text <>